home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gr_col.exe / GR_DEMO1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-17  |  7KB  |  228 lines
  1. { == GR_DEMO1.PAS =============================================================
  2.  
  3.   Demo program to illustrate some of the uses of the XorColConv procedure.
  4.   XorColConv is fully documented in the file GR_COL2G.PAS. Comments are removed
  5.   here to save space.
  6.  
  7.   Written by Jerry Rivers. Last modified: 04/16/93
  8.  
  9.   ============================================================================= }
  10.  
  11. PROGRAM Gr_Demonstration;
  12.  
  13.   uses Graph, Crt;
  14.   const
  15.     ColNam : array[0..15] of string[12] = (
  16.               'Black',    'Blue',         'Green',      'Cyan',
  17.               'Red',      'Magenta',      'Brown',      'LtGray',
  18.               'DarkGray', 'LtBlue',       'LtGreen',    'LtCyan',
  19.               'LtRed',    'LtMagenta',    'Yellow',     'White' );
  20.  
  21.   var
  22.     Ch              : char;
  23.     ColorBack,
  24.     ColorIn,
  25.     ColorOut        : integer;
  26.     ColorTest       : longint;
  27.     Driver          : integer;
  28.     Escape          : boolean;
  29.     GRreturn        : integer;
  30.     I               : integer;
  31.     Mode            : integer;
  32.     Str             : string;
  33.  
  34. { == XorColConv ===============================================================
  35.  
  36.   Calculates color resulting from background XOR foreground in graphics
  37.  
  38.   Written by Jerry Rivers. Last modified: 04/16/93
  39.  
  40.   ============================================================================= }
  41.  
  42. PROCEDURE XorColConv( ColBkGnd, ColSet : integer; var ColResult : integer );
  43.   const
  44.     ColVal : array[0..15] of longint = (
  45.                     0,         42,          10752,        10794,
  46.               2752512,    2752554,        2757888,      2763306,
  47.               1381653,    1381695,        1392405,      1392447,
  48.               4134168,    4134207,        4144917,      4144959 );
  49.   var
  50.     Color1, Color2, Color3 : longint;
  51.     I                      : byte;
  52.     OK                     : boolean;
  53.     RGB                    : array[1..30] of longint;        { RGB exceptions }
  54.     Col                    : array[1..30] of integer;  { corresponding colors }
  55.   begin
  56.     {
  57.       Initialize the Color exception tables
  58.     }
  59.     RGB[ 1] := 2757930;  Col[ 1] :=  7;
  60.     RGB[ 2] := 2763264;  Col[ 2] :=  6;
  61.     RGB[ 3] := 4134194;  Col[ 3] := 13;
  62.     RGB[ 4] := 4134165;  Col[ 4] := 12;
  63.     RGB[ 5] := 2768640;  Col[ 5] :=  4;
  64.     RGB[ 6] := 4144920;  Col[ 6] := 14;
  65.     RGB[ 7] := 2768682;  Col[ 7] :=  5;
  66.     RGB[ 8] := 4144946;  Col[ 8] := 15;
  67.     RGB[ 9] :=    5376;  Col[ 9] :=  2;
  68.     RGB[10] := 1381656;  Col[10] :=  8;
  69.     RGB[11] :=    5418;  Col[11] :=  3;
  70.     RGB[12] := 1381682;  Col[12] :=  9;
  71.     RGB[13] :=   16170;  Col[13] :=  1;
  72.     RGB[14] := 4128789;  Col[14] := 14;
  73.     RGB[15] := 4128831;  Col[15] := 15;
  74.     RGB[16] := 4139541;  Col[16] := 12;
  75.     RGB[17] := 4139583;  Col[17] := 13;
  76.     RGB[18] := 1376280;  Col[18] := 10;
  77.     RGB[19] := 1376319;  Col[19] := 11;
  78.     RGB[20] := 1387029;  Col[20] :=  8;
  79.     RGB[21] := 1387071;  Col[21] :=  9;
  80.     RGB[22] := 1392434;  Col[22] := 11;
  81.     RGB[23] := 2752525;  Col[23] :=  4;
  82.     RGB[24] := 2752551;  Col[24] :=  5;
  83.     RGB[25] := 2763277;  Col[25] :=  6;
  84.     RGB[26] := 2763303;  Col[26] :=  7;
  85.     RGB[27] :=      39;  Col[27] :=  1;
  86.     RGB[28] :=   10765;  Col[28] :=  2;
  87.     RGB[29] :=   10791;  Col[29] :=  3;
  88.     {
  89.       Get long integer RGB color numbers for background and "desired" color
  90.     }
  91.     Color1 := ColVal[ ColBkGnd ];
  92.     Color2 := ColVal[ ColSet ];
  93.     Color3 := Color1 XOR Color2;
  94.     {
  95.       If the XOR color matches a "standard" VGA color, you're done!
  96.     }
  97.     I := 0; OK := false;
  98.     repeat
  99.       if Color3 = ColVal[ I ] then
  100.         begin
  101.           ColResult := I;                 { return corresponding color number }
  102.           OK := true;                                     { signal OK to quit }
  103.         end;
  104.         inc( I );
  105.     until ( I > White );
  106.     {
  107.       If the XOR color isn't "standard", look at the "exception" list
  108.  
  109.       This list was built by checking all the Color3's that aren't
  110.       "standard" and visually identifying the matching color
  111.  
  112.       A 29-long look-up table may not be the most efficient, but it works!
  113.     }
  114.     if not OK then begin
  115.         I := 1;
  116.         repeat
  117.           if Color3 = RGB[ I ] then
  118.             begin
  119.               ColResult := Col[ I ];      { return corresponding color number }
  120.               OK := true;                                 { signal OK to quit }
  121.             end;
  122.           inc( I ) ;
  123.         until OK or ( I > 29 );
  124.       end;
  125.     {
  126.       If the bell rings, a color slipped thru the exception table;
  127.       This should never happen
  128.     }
  129.     if not OK then writeln( chr(7) );
  130.  
  131.   end; { XorColConv }
  132.  
  133.   BEGIN  { --- Main Program --- }
  134.     {
  135.       This program assumes you are running standard VGA 16-color graphics
  136.       If you're not, an error will result and the program will stop
  137.     }
  138.     Driver := VGA;
  139.     Mode   := VGAhi;
  140.  
  141.     InitGraph(Driver, Mode, '');
  142.  
  143.     GRreturn := GraphResult;
  144.     if GRreturn <> 0 then begin
  145.         writeln( 'Couldn''t start Scene-may be graphics or video problem' );
  146.         writeln( GraphErrorMsg( GRreturn ) );
  147.         halt;
  148.       end;
  149.     {
  150.       Turn direct video off so standard writeln works in graphics
  151.     }
  152.     DirectVideo := false;
  153.  
  154.     ColorBack := Magenta;
  155.     {
  156.       Set background to arbitray color
  157.     }
  158.     SetFillStyle( SolidFill, ColorBack );
  159.     Bar( 0, 0, 639, 479 );
  160.  
  161.     Str := 'This string will be written then erased one character at a time';
  162.     {
  163.       Set "desired" foreground color as "color in"
  164.     }
  165.     XorColConv( ColorBack, Yellow, ColorOut );
  166.     {
  167.       "color out" is the XOR inverse of the "desired" color, so setting
  168.       TextColor to ColorOut will XOR back onto the graphics screen in
  169.       the original "desired" color (ColorIn)
  170.  
  171.       Confusing, but it works!
  172.     }
  173.     TextColor( ColorOut + 128 );
  174.  
  175.     gotoXY( 5, 15);
  176.     writeln( Str );
  177.     delay(1500);
  178.     {
  179.       Erase by re-writing text, one character at a time. Since this is an
  180.       XOR write, the string will be erased
  181.     }
  182.     gotoXY( 5, 15 );
  183.     for I := 1 to length( Str ) do
  184.       begin
  185.         write( Str[I] );
  186.         delay( 100 );
  187.       end;
  188.     {
  189.       Now, write the string again, this time in LightRed color
  190.     }
  191.     delay(300);
  192.     XorColConv( ColorBack, LightRed, ColorOut );
  193.     TextColor( ColorOut + 128 );
  194.     {
  195.       Write one character at a time, backwards
  196.     }
  197.     for I := length( Str ) downto 1 do
  198.       begin
  199.         gotoXY( 5 + I, 15 );
  200.         write( Str[I] );
  201.         delay( 100 );
  202.       end;
  203.  
  204.     {
  205.       Now, simulate blinking text, this time with LightCyan background and
  206.       Black foreground text
  207.     }
  208.     ColorBack := LightCyan;
  209.     SetFillStyle( SolidFill, ColorBack );
  210.     Bar( 50, 30, 600, 200 );
  211.  
  212.     XorColConv( ColorBack, LightRed, ColorOut );
  213.     TextColor( ColorOut + 128 );
  214.     gotoXY( 15, 10 );
  215.     write( 'PRESS ANY KEY TO QUIT ' );
  216.  
  217.     XorColConv( ColorBack, Black, ColorOut );
  218.     TextColor( ColorOut + 128 );
  219.     {
  220.       blink text until user presses a key
  221.     }
  222.     repeat
  223.         gotoXY( 10, 5 );
  224.         writeln( Str );
  225.         delay(70);
  226.     until KeyPressed
  227.   END.
  228.